home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0391B.ZIP / NEWEXEC.PAS < prev    next >
Pascal/Delphi Source File  |  1987-02-22  |  11KB  |  245 lines
  1. { EXEC.PAS version 1.2                                                 }
  2.  
  3. { This file contains  2 functions for  Turbo Pascal  that allow you to }
  4. { run other programs from within a Turbo program.  The first function, }
  5. { SubProcess,  actually calls up a different program using MS-DOS call }
  6. { 4BH, EXEC.  The second function,  GetComSpec,  returns the path name }
  7. { of  the  command  interpreter,  which is  necessary  to  do  certain }
  8. { operations. There is also a main program that allows you to test the }
  9. { functions.                                                           }
  10.  
  11. {----------------------------------------------------------------------}
  12.  
  13. { Version 1.1  works with  DOS 2.0 and 2.1.  Version 1.0  only  worked }
  14. { with DOS 3.0 due to a subtle bug in DOS 2.x.                         }
  15.  
  16. { -  Bela Lubkin                                                       }
  17. {    Borland International Technical Support                           }
  18. {    CompuServe 71016,1573                                             }
  19.  
  20. {----------------------------------------------------------------------}
  21.  
  22. { Version 1.2  corrects a compiling problem in the INLINE code area of }
  23. { SubProcess. The line:                                                }
  24. {     INLINE ($8D/$96/ PathName+1 /                                    }
  25. { will always grenerate a   ") required"  at the  +  sign.  Apparently }
  26. { Turbo  only  allows  displacements on  location  counter  references }
  27. { within the INLINE code (i.e. not on variable identifiers).           }
  28.  
  29. { -  James Tuksal                                                      }
  30. {    Burroughs Corporation                                             }
  31. {    14115 Farmington Rd.                                              }
  32. {    Livonia, Michigan                                                 }
  33. {    48154                                                             }
  34.  
  35. {----------------------------------------------------------------------}
  36.  
  37. TYPE
  38.  Str66  = STRING [66];
  39.  Str255 = STRING [255];
  40.  
  41.  
  42. { Pass SubProcess a string of the form:                                }
  43. { 'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'            }
  44.  
  45. { For example,                                                         }
  46. {   'C:\SYSTEM\CHKDSK.COM'                                             }
  47. {   'A:\WS.COM DOCUMENT.1'                                             }
  48. {   'C:\DOS\LINK.EXE TEST;'                                            }
  49. {   'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'               }
  50.  
  51. { The  fourth  example  shows  several  things.   To  do  any  of  the }
  52. { following,  you must invoke the  command processor and let it do the }
  53. { work:                                                                }
  54.  
  55. {       redirection                                                    }
  56. {       piping                                                         }
  57. {       path searching                                                 }
  58. {       searching for the extension of a program (.COM, .EXE, or .BAT) }
  59. {       batch files;                                                   }
  60. {       internal DOS commands                                          }
  61.  
  62. { The  name  of the  command  processor  file  is  stored in  the  DOS }
  63. { environment.  The function  GetComSpec in this file returns the path }
  64. { name of the  command processor.  Also note that you must use the  /C }
  65. { parameter or  COMMAND  will not  work correctly.  You can  also call }
  66. { COMMAND with no parameters.  This will allow the user to use the DOS }
  67. { prompt to run anything  (as long as there is enough memory).  To get }
  68. { back to your program, he can type the command EXIT.                  }
  69.  
  70. { Actual example:                                                      }
  71. {   I:=SubProcess (GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED'); }
  72.  
  73. { The value  returned is  the result  returned by  DOS after  the EXEC }
  74. { call.  The most common values are:                                   }
  75.  
  76. {      0: Success                                                      }
  77. {      1: Invalid function (should never happen with this routine)     }
  78. {      2: File/path not found                                          }
  79. {      8: Not enough memory to load program                            }
  80. {     10: Bad environment (greater than 32K)                           }
  81. {     11: Illegal .EXE file format                                     }
  82.  
  83. { If you get any other result,  consult an  MS-DOS Technical Reference }
  84. { manual.                                                              }
  85.  
  86. { VERY IMPORTANT NOTE:  you MUST use  the Options menu of Turbo Pascal }
  87. { to  restrict  the amount  of  free   dynamic  memory   used by  your }
  88. { program.  Only  the  memory  that is   not  used  by  the   heap  is }
  89. { available for use by other programs.                                 }
  90.  
  91.  FUNCTION SubProcess (CommandLine : Str255): INTEGER;
  92.   CONST
  93.    SSSave: INTEGER=0;
  94.    SPSave: INTEGER=0;
  95.   VAR
  96.    Regs        : RECORD CASE INTEGER OF
  97.                   1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER);
  98.                   2: (AL, AH, BL, BH, CL, CH, DL, DH            : BYTE);
  99.                  END;
  100.    FCB1        : ARRAY [0..36] OF BYTE;
  101.    FCB2        : ARRAY [0..36] OF BYTE;
  102.    PathName    : Str66;
  103.    CommandTail : Str255;
  104.    ParmTable   : RECORD
  105.                   EnvSeg : INTEGER;
  106.                   ComLin : ^INTEGER;
  107.                   FCB1Pr : ^INTEGER;
  108.                   FCB2Pr : ^INTEGER;
  109.                  END;
  110.   BEGIN
  111.    IF POS (' ', CommandLine)=0 THEN
  112.     BEGIN
  113.      PathName:=CommandLine+#0;
  114.      CommandTail:=^M;
  115.     END                                 { if                           }
  116.    ELSE
  117.     BEGIN
  118.      PathName:=COPY (CommandLine, 1, POS (' ', CommandLine)-1)+#0;
  119.      CommandTail:=COPY (CommandLine, POS (' ', CommandLine), 255)+^M;
  120.     END;                                { else                         }
  121.    CommandTail [0]:=PRED (CommandTail [0]);
  122.    WITH Regs Do
  123.     BEGIN
  124.      FILLCHAR (FCB1, SIZEOF (FCB1), 0);
  125.      AX:=$2901;
  126.      DS:=SEG (CommandTail [1]);
  127.      SI:=OFS (CommandTail [1]);
  128.      ES:=SEG (FCB1);
  129.      DI:=OFS (FCB1);
  130.      MSDOS (Regs);                      { Create FCB 1                 }
  131.      FILLCHAR (FCB2, SIZEOF (FCB2), 0);
  132.      AX:=$2901;
  133.      ES:=SEG (FCB2);
  134.      DI:=OFS (FCB2);
  135.      MSDOS (Regs);                      { Create FCB 2                 }
  136.      ES:=CSeg;
  137.      BX:=SSEG-CSEG+MEMW [CSEG:MEMW [CSEG:$0101]+$112];
  138.      AH:=$4A;
  139.      MSDOS (Regs);                      { Deallocate unused memory     }
  140.      WITH ParmTable DO
  141.       BEGIN
  142.        EnvSeg:=MEMW [CSEG:$002C];
  143.        ComLin:=ADDR (CommandTail);
  144.        FCB1Pr:=ADDR (FCB1);
  145.        FCB2Pr:=ADDR (FCB2);
  146.       END;                              { with                         }
  147.      INLINE ($BF/$01/$00/               {+MOV     DI,0001h               }
  148.              $8D/$93/PathName/          {>LEA     DX,[BP+DI+DS:PathName] }
  149.              $8D/$9E/ParmTable/         { LEA     BX,[BP+DS:ParmTable]   }
  150.              $B8/$00/$4B/               { MOV     AX,4B00h               }
  151.              $1E/                       { PUSH    DS                     }
  152.              $55/                       { PUSH    BP                     }
  153.              $16/                       { PUSH    SS                     }
  154.              $1F/                       { POP     DS                     }
  155.              $16/                       { PUSH    SS                     }
  156.              $07/                       { POP     ES                     }
  157.              $2E/$8C/$16/SSSave/        { MOV     CS:SSSave,SS           }
  158.              $2E/$89/$26/SPSave/        { MOV     CS:SPSave,SP           }
  159.              $FA/                       { CLI                            }
  160.              $CD/$21/                   { INT     21h                    }
  161.              $FA/                       { CLI                            }
  162.              $2E/$8B/$26/SPSave/        { MOV     SP,CS:SPSave           }
  163.              $2E/$8E/$16/SSSave/        { MOV     SS,CS:SSSave           }
  164.              $FB/                       { STI                            }
  165.              $9C/                       { PUSHF                          }
  166.              $BF/$12/$00/               {+MOV     DI,0012h               }
  167.              $3E/$8F/$83/Regs/          {>POP     [BP+DI+DS:Regs]        }
  168.              $3E/$89/$86/Regs/          { MOV     [BP+DS:Regs],AX        }
  169.              $5D/                       { POP     BP                     }
  170.              $1F);                      { POP     DS                     }
  171.  
  172. { + Line added    to correct compile problem in 1.1                    }
  173. { > Line modified to correct compile problem in 1.1                    }
  174.  
  175. { The messing around with SS and SP is necessary because under DOS 2.x }
  176. { after  returning  from an  EXEC call,  ALL registers  are  destroyed }
  177. { except  CS and IP!  I wish I'd  known that  before I  released  this }
  178. { package the first time...                                            }
  179.  
  180.      IF (Flags AND 1)<>0 THEN
  181.       SubProcess:=AX
  182.      ELSE
  183.       SubProcess:=0;
  184.     END;                                { with                         }
  185.   END;                                  { SubProcess                   }
  186.  
  187.  FUNCTION GetComSpec : Str66;
  188.   TYPE
  189.    Env=ARRAY [0..32767] OF CHAR;
  190.   VAR
  191.    EPtr : ^Env;
  192.    EStr : Str255;
  193.    Done : BOOLEAN;
  194.    I    : INTEGER;
  195.   BEGIN
  196.    EPtr:=PTR (MEMW [CSEG:$002C],0);
  197.    I:=0;
  198.    Done:=FALSE;
  199.    EStr:='';
  200.    REPEAT
  201.     IF EPtr^[I]=#0 THEN
  202.      BEGIN
  203.       IF EPtr^ [I+1]=#0 THEN
  204.        Done:=TRUE;
  205.       IF COPY (EStr, 1, 8)='COMSPEC=' THEN
  206.        BEGIN
  207.         GetComSpec:=COPY (EStr, 9, 100);
  208.         Done:=TRUE;
  209.        END;                             { if                           }
  210.       EStr:='';
  211.      END                                { if                           }
  212.     ELSE
  213.      EStr:=EStr+EPtr^[I];
  214.     I:=I+1;
  215.    UNTIL Done;
  216.   END;                                  { GetComSpec                   }
  217.  
  218. { Example program.  Set both  mInimum and mAximum  free dynamic memory }
  219. { to 100 and compile  this to a .COM  file.  Delete the  next  line to }
  220. { enable:                                                              }
  221. {
  222.  
  223.  VAR
  224.   Command : Str255;
  225.   I       : INTEGER;
  226.  
  227.  BEGIN
  228.   WRITELN ('Enter a * to quit; put a * before a command to use COMMAND.COM.');
  229.   REPEAT
  230.    WRITE  ('=->');
  231.    READLN (Command);
  232.    IF Command='*' THEN
  233.     HALT;
  234.    IF Command<>'' THEN
  235.     BEGIN
  236.      IF Command [1]='*' THEN
  237.       Command:=GetComSpec+' /C '+COPY (Command, 2, 255);
  238.      I:=SubProcess (Command);
  239.      IF I<>0 THEN
  240.       WRITELN ('Error - ',I);
  241.     END;
  242.   UNTIL FALSE;
  243.  END.
  244. }
  245.